home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
Atari Mega Archive 1
/
Atari Mega Archive - Volume 1.iso
/
language
/
f77.lzh
/
F77.C
next >
Wrap
C/C++ Source or Header
|
1992-01-23
|
9KB
|
248 lines
/* Compiler-Driver for BC-Fortran-77
*
* (C)1992, Ulf Bartelt
*
* History (youngest first):
*
* 920122 - started in Sozobon-C 2.0
* 920123 - Option -n ans some bugfixes
* - Dgetdrv/Dsetdrv used additionally to chdir()...
*/
#include <stdio.h>
#include <string.h>
#include <ctype.h>
#include <osbind.h>
extern char *getenv();
void usage()
{ fputs("BC-FORTRAN-77 Driver V.0.12, (C)1992 by Ulf Bartelt\n",stderr);
fputs(" -c compile only\n",stderr);
fputs(" -f no casefolding, distinguish upper and lowercase\n",stderr);
fputs(" -g compile with debug code\n",stderr);
fputs(" -n no actions, only show commands...\n",stderr);
fputs(" -O optimize (currently only optimizes linking)\n",stderr);
fputs(" -r don't link with MATHLIB.B\n",stderr);
fputs(" -sn set stack size to n kBytes\n",stderr);
fputs(" -v verbose compile and link\n",stderr);
fputs(" -vc verbose compile\n",stderr);
fputs(" -vl verbose link\n",stderr);
exit(0);
}
char filetype( file )
char *file;
{ register char *cp=file, *lb, *lp;
while( *cp )
if( *cp == '\\' ) lb=cp++;
else if( *cp == '.' ) lp=cp++;
else cp++;
if( lb < lp && lp[2] == 0 )
switch( toupper(lp[1]) )
{ case 'F' : return 'F';
case 'B' : return 'B';
}
return 0;
}
char *f_2_b( file ) /* a legal source file name is assumend !!! */
char *file; /* i.e.: <drive:\path\name>.f */
{ register char *cp = file;
register char *lp; /* last (p)oint */
while( *cp ) if( *cp == '.' ) lp=cp++; else cp++;
lp[1] = 'b';
return file;
}
int main( argc, argv )
int argc;
char *argv[];
{
int retcode = 0;
char bcf_opts[40];
char bcl_opts[40];
char bcf_files[129];
char bcl_files[129];
char bcf_exec[129];
char bcl_exec[129];
char stacksize[21];
struct {
unsigned c_casefold:1; /* -f ==> -U for compiler */
unsigned c_debug:1; /* -g ==> -D for compiler */
unsigned c_verbose:1; /* -v or -vc ==> -L for compiler */
unsigned l_mathlib:1; /* -r */
unsigned l_optimize:1; /* -O ==> -O for linker */
unsigned l_stacksize:1; /* -s<n> ==> -S<n> for linker */
unsigned l_verbose:1; /* -v or -vl ==> -L for linker */
unsigned x_nolink:1; /* -c */
unsigned x_donothing:1; /* -n */
unsigned got_f_files:1; /* *.f files in arglist */
unsigned got_b_files:1; /* *.b files in arglist */
} flags;
flags.c_casefold = 1;
flags.c_debug = 0;
flags.c_verbose = 0;
flags.got_b_files = 0;
flags.got_f_files = 0;
flags.l_mathlib = 1;
flags.l_optimize = 0;
flags.l_stacksize = 0;
flags.l_verbose = 0;
flags.x_nolink = 0;
flags.x_donothing = 0;
strcpy(bcf_files,"");
strcpy(bcl_files,"");
{ int i=1;
char *file[129];
while( i<argc )
{ if( argv[i][0]=='-' ) /* collect options */
{ switch( argv[i][1] )
{
case '?': /* help */
case 'h': usage();
/* "break"ed by exit in usage() */
case 'c': flags.x_nolink = 1;
break;
case 'f': flags.c_casefold = 0;
break;
case 'g': /* debug */
flags.c_debug = 1;
break;
case 'n': flags.x_donothing = 1;
break;
case 'O': /* optimizing link */
flags.l_optimize = 1;
break;
case 'r': flags.l_mathlib = 0;
break;
case 's': flags.l_stacksize = 1;
strcpy(stacksize,argv[i]);
strcat(stacksize," ");
stacksize[1]='S'; /* BCL wants "S" */
break;
case 'v': /* verbose */
switch( argv[i][2] )
{ case 000: flags.l_verbose = 1;
case 'c': flags.c_verbose = 1; break;
case 'l': flags.l_verbose = 1; break;
default : fprintf(stderr,"unknown option \"%s\"...\n",argv[i]);
exit(1);
}
break;
default : /* option error */
fprintf("unknown option \"%s\"...\n",argv[i]);
exit(1);
}
}
else /*if( argv[i][0]!='-' )*/ /* collect files */
{ if( fullpath(file,argv[i]) )
{
switch( filetype(file) )
{ case 'F': flags.got_f_files = 1;
strcat(bcf_files,file);
strcat(bcf_files," ");
strcat(bcl_files,f_2_b(file));
strcat(bcl_files," ");
break;
case 'B': flags.got_b_files = 1;
strcat(bcl_files,file);
strcat(bcl_files," ");
break;
default : fprintf(stderr,"Illegal suffix: %s\n",file);
exit(1);
}
}
}
++i;
}
}
if( flags.got_f_files && flags.got_b_files )
{ fputs("can't mix operations on *.f and *.b...\n",stderr);
exit(1);
}
strcpy(bcf_opts,"");
strcpy(bcl_opts,"");
if( flags.c_debug ) strcat(bcf_opts,"-D ");
if( flags.c_verbose ) strcat(bcf_opts,"-P ");
if( flags.c_casefold ) strcat(bcf_opts,"-U ");
if( flags.l_optimize ) strcat(bcl_opts,"-O ");
if( flags.l_verbose ) strcat(bcl_opts,"-P ");
if( flags.l_stacksize ) strcat(bcl_opts,stacksize);
if( flags.l_mathlib ) strcat(bcl_files,"mathlib.b");
if( flags.got_f_files )
{ char *execpath, *cp, command[129];
execpath = getenv("BCF_EXEC"); /* if NULL, pfindfile uses $PATH */
cp = pfindfile(execpath,"BCF.TTP");
if( !cp ) { fputs("compiler not found.\n",stderr); exit(1); }
else strcpy(bcf_exec,cp);
sprintf(command,"%s %s%s",bcf_exec,bcf_opts,bcf_files);
if( flags.c_verbose || flags.x_donothing ) puts(command);
if( !flags.x_donothing )
{ retcode = system(command);
if( retcode ) { fputs("compiler failed !\n",stderr); exit(retcode); }
/* Das funktioniert leider nicht...
* Der Code bleibt aber trotzdem drin !
*/
}
}
if( (flags.got_f_files && !flags.x_nolink) || flags.got_b_files )
{ char *execpath, *libpath, *cp, drive = Dgetdrv(), libdrv;
char cwd[129],command[129];
execpath = getenv("BCF_EXEC"); /* if NULL, pfindfile uses $PATH */
cp = pfindfile(execpath,"BCL.TTP");
if( !cp ) { fputs("linker not found.\n",stderr); exit(1); }
else strcpy(bcl_exec,cp);
if( !getcwd(cwd,128) ) { fputs("can't get cwd\n",stderr); exit(1); }
libpath = getenv("BCF_LIB");
if( libpath )
{ if( flags.l_verbose || flags.x_donothing ) printf("cd %s\n",libpath);
libdrv = toupper(*libpath)-'A';
if( !flags.x_donothing
&& (Dsetdrv(libdrv) & (1u<<libdrv))
&& chdir(libpath)
) { fputs("can't set path to libs.\n",stderr); exit(1); }
}
sprintf(command,"%s %s%s",bcl_exec,bcl_opts,bcl_files);
if( flags.l_verbose || flags.x_donothing ) puts(command);
if( !flags.x_donothing ) retcode = system(command);
if( flags.l_verbose || flags.x_donothing ) printf("cd %s\n",cwd);
if( !flags.x_donot